<%
'######################################################################
'## util.accmakesql.asp
'## -------------------------------------------------------------------
'## Feature     :   AspBox Mvc AccMakeSQL-Util Block
'## Version     :   v1.0
'## Author      :   Lajox(lajox@19www.com)
'## Update Date :   2012/06/10 23:21
'## Description :   AspBox Mvc AccMakeSQL-Util Block(MakeSQL工具拓展模块)
'######################################################################

Class Cls_Util_AccMakeSQL

	Private cfg_accdb, temp_accdb
	Private tpl_header, tpl_main, tpl_footer
	Private Conn,ConnStr
	Private enMode

	Private Sub Class_Initialize()
		cfg_accdb = "/data/mydb.mdb"
		temp_accdb = cfg_accdb
		enMode = 0
		InitTpl()
	End Sub

	Private Sub Class_Terminate()

	End Sub

	'@ *****************************************************************************
	'@ 过程名:  Util.AccMakeSQL.ShowPage()
	'@ 返  回:  无返回值
	'@ 作  用:  “Access SQL脚本编写器”主页面显示
	'==Param========================================================================
	'@ 参数 : 无
	'==DEMO=========================================================================
	'@ ab.use "mvc" : AB.C.Clear : Util.Lib("AccMakeSQL").ShowPage()
	'@ *****************************************************************************

	Sub ShowPage()
		If Request.Form<>"" and Request.QueryString("action")<>"" Then
			dim form_dbname,form_enMode
			form_enMode = strSafe(Request.Form("form_enMode"))
			form_dbname = strSafe(Request.Form("form_dbname"))
			if not isnumeric(form_enMode) then form_enMode=0
			Call SetData(form_enMode, form_dbname)
			Call openDB(temp_accdb)
			Call CreateSQL(temp_accdb,form_enMode)
		Else
			if temp_accdb="" then temp_accdb="/data/mydb.mdb"
			Call Main()
		End If
	End Sub

	Sub MAIN()
		Response.Write tpl_header & tpl_main & tpl_footer
	End Sub

	Function SetData(Byval Mode, Byval db)
		If CLng(Mode)>=0 Then enMode = Mode
		If Trim(db)<>"" Then temp_accdb = db
	End Function

	Sub InitTpl()
		tpl_header = tpl_header & ""
		tpl_header = tpl_header & "<!DOCTYPE HTML PUBLIC '-//W3C//DTD HTML 4.0 Transitional//EN'>" & VbCrlf
		tpl_header = tpl_header & "<HTML>" & VbCrlf
		tpl_header = tpl_header & "<HEAD>" & VbCrlf
		tpl_header = tpl_header & "<TITLE>Access SQL脚本编写器</TITLE>" & VbCrlf
		tpl_header = tpl_header & "<META NAME='Generator' CONTENT='EditPlus'>" & VbCrlf
		tpl_header = tpl_header & "<META NAME='Author' CONTENT='V37'>" & VbCrlf
		tpl_header = tpl_header & "<META NAME='Keywords' CONTENT='PaintBlue.Net,PaintBlue'>" & VbCrlf
		tpl_header = tpl_header & "<META NAME='Description' CONTENT='PaintBlue.Net'>" & VbCrlf
		tpl_header = tpl_header & "<style>body,table,td{color: #000000;font-size: 9pt;}table{FONT-FAMILY: 'Tahoma','MS Shell Dlg';}</style>" & VbCrlf
		tpl_header = tpl_header & "</HEAD>" & VbCrlf
		tpl_header = tpl_header & "<body bgCOLOR=eeeeee text='#000000' leftmargin='0' marginwidth='100%' topmargin='0' bottommargin='20'>" & VbCrlf
		'---
		tpl_main = tpl_main & ""
		tpl_main = tpl_main & "<style>" & VbCrlf
		tpl_main = tpl_main & ".titlebar {" & VbCrlf
		tpl_main = tpl_main & "	FONT-WEIGHT: bold; FONT-SIZE: 12pt; FILTER: dropshadow(color=#333333, offx=1, offy=2); WIDTH: 100%; COLOR: #ffffff; FONT-FAMILY: Tahoma,Verdana, Arial, sans-serif; POSITION: relative; TOP: 1px" & VbCrlf
		tpl_main = tpl_main & "}" & VbCrlf
		tpl_main = tpl_main & "</style>" & VbCrlf
		tpl_main = tpl_main & "<FORM METHOD=POST ACTION='?action=1' Name=DBform>" & VbCrlf
		tpl_main = tpl_main & "<TABLE width='100%' cellspacing=0 border=0>" & VbCrlf
		tpl_main = tpl_main & "	<TR bgcolor=#D4D0C8>" & VbCrlf
		tpl_main = tpl_main & "		<TD align=center height=32></td><td><span class=titlebar><font color=#ffffff><b>Access 脚本编写器</b></font></span></TD>" & VbCrlf
		tpl_main = tpl_main & "	<td></td></TR>" & VbCrlf
		tpl_main = tpl_main & "<TABLE align=center width='100%' cellspacing=1 cellpadding=3 border=0>" & VbCrlf
		tpl_main = tpl_main & "</TABLE>" & VbCrlf
		tpl_main = tpl_main & "<TABLE align=center width='100%' cellspacing=1 cellpadding=3 border=0>" & VbCrlf
		tpl_main = tpl_main & "<TR  bgcolor=#a4c0d8><TD align=right  height=10></TD><TD></TD></TR>" & VbCrlf
		tpl_main = tpl_main & "<TR bgcolor=#D4D0C8>" & VbCrlf
		tpl_main = tpl_main & "	<TD align=right><span id=a>编写模式</span></TD>" & VbCrlf
		tpl_main = tpl_main & "	<TD>" & VbCrlf
		tpl_main = tpl_main & "	<INPUT TYPE='radio' NAME='form_enMode' value='0' checked>Sql文本" & VbCrlf
		tpl_main = tpl_main & "	<INPUT TYPE='radio' NAME='form_enMode' value='1'>Asp代码" & VbCrlf
		tpl_main = tpl_main & "	</TD>" & VbCrlf
		tpl_main = tpl_main & "</TR>" & VbCrlf
		tpl_main = tpl_main & "<TR bgcolor=#D4D0C8>" & VbCrlf
		tpl_main = tpl_main & "	<TD align=right width=250>数据库路径</TD>" & VbCrlf
		tpl_main = tpl_main & "	<TD><INPUT TYPE='text' NAME='form_dbname' value='" & temp_accdb & "' style='width:70%;'> </TD>" & VbCrlf
		tpl_main = tpl_main & "</TR>" & VbCrlf
		tpl_main = tpl_main & "<TR bgcolor=#a4c0d8><TD align=right  height=10></TD><TD></TD></TR>" & VbCrlf
		tpl_main = tpl_main & "<TR>" & VbCrlf
		tpl_main = tpl_main & "	<TD height=38></TD>" & VbCrlf
		tpl_main = tpl_main & "	<TD bgcolor=#D4D0C8>&nbsp;&nbsp;<INPUT TYPE='submit' value=' 确 定 ' style='width:80;'></TD>" & VbCrlf
		tpl_main = tpl_main & "</TR>" & VbCrlf
		tpl_main = tpl_main & "<TR>" & VbCrlf
		tpl_main = tpl_main & "	<TD height=38></TD>" & VbCrlf
		tpl_main = tpl_main & "	<TD bgcolor=#D4D0C8>&nbsp;&nbsp;" & VbCrlf
		tpl_main = tpl_main & "	<li><<简介>>" & VbCrlf
		tpl_main = tpl_main & "	<li>功能:可编写Access数据库的常用的主要对象,包括 <br>&nbsp;&nbsp;&nbsp;&nbsp;<b>表,视图,索引,约束,包括 默认值,主键,自动编号,外键</b>(表关系)" & VbCrlf
		tpl_main = tpl_main & "	<li>编写完自动保存为原数据库名+相应扩展的文件" & VbCrlf
		tpl_main = tpl_main & "	<li>Asp模式可直接生成带表单输入的可执行的Asp文件,用生成的Asp文件即可生成新的数据库" & VbCrlf
		tpl_main = tpl_main & "	<li>Sql模式可直接生成纯Sql语句文本</li><br><br></TD>" & VbCrlf
		tpl_main = tpl_main & "</TR>" & VbCrlf
		tpl_main = tpl_main & "</Table>" & VbCrlf
		tpl_main = tpl_main & "</FORM>" & VbCrlf
		'---
		tpl_footer = ""
		tpl_footer = tpl_footer & "<hr size=1><center>Copyright &copy; 2011</center><hr size=1><br></BODY></HTML>"
	End Sub

	Sub CreateSQL(Byval dbName,Byval exec)
		'创建模式
		'exec = 0 : 生成SQL语句
		'exec = 1 : 生成Asp程序
		Response.Write tpl_header & "" & VBCrlf
		dim tbls,tabsArr,ub,I,temp,tplHead
		dim TableStr
		if exec=1 then
			tplHead="<"&"% @ LANGUAGE=""VBSCRIPT""%"&">"&vbcrlf
			tplHead=tplHead&"<"&"%Option Explicit"&vbcrlf
			tplHead=tplHead&"Response.Buffer=true"&vbcrlf&vbcrlf
			tplHead=tplHead&""&vbcrlf&"'Access 数据库 SQL 脚本生成"&vbcrlf&""&vbcrlf&vbcrlf
		end if
		if instr(dbName,":\")=0 and instr(dbName,":/")=0 then
			dbName=Server.MapPath(dbName)
		end if
		ConnStr="Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbName
		Set CONN = Server.CreateObject("ADODB.Connection")
		Conn.Open ConnStr
		'编写CONN对象
		if exec=1 then
			temp="Sub CreateDB(Byval dbName)"&vbcrlf
			temp=temp&"DIM CONN"&vbcrlf
			temp=temp&"Set CONN=Server.CreateObject(""ADODB.Connection"")"&vbcrlf
			temp=temp&"Conn.open ""Provider=Microsoft.Jet.OLEDB.4.0;Data Source=""&dbName"&vbcrlf&vbcrlf
		end if
		'编写表/索引对象
		Set tbls=Conn.openSchema(20) 'adSchemaPrimaryKeys
			tbls.Filter =" TABLE_TYPE='TABLE' " '筛选出有默认值，但允许null的列
		while Not tbls.eof
			TableStr=TableStr&"|"&tbls("TABLE_Name")
			tbls.movenext
		wend
		tbls.filter=0
		tbls.close
		set tbls=nothing
		TableStr=mid(TableStr,2)
		if TableStr<>"" then
			tabsArr=split(TableStr,"|")
			ub=ubound(tabsArr)
			for I=0 to ub
				if exec=1 then temp=temp&"'["&tabsArr(I)&"]:"& vbcrlf
				temp=temp&CreatTableSql(tabsArr(I),exec)&vbcrlf&vbcrlf
			next
		end if
		'编写表关系
		if TableStr<>"" then temp=temp&CreatForeignSql(exec)
		'编写视图
		temp=temp&CreatViewSql(exec)
		if exec=1 then
			temp=replace(temp,">","""&chr(62)&""")
			temp=replace(temp,"<","""&chr(60)&""")
			temp=temp&"End Sub"& vbcrlf&vbcrlf
			temp=temp&"	call CreateMDB()"&vbcrlf
			temp=temp&"Sub Main()"&vbcrlf
			temp=temp&"	Response.write(""<center><FORM METHOD=POST><input name='form_dbname' Value="""""&Server.Htmlencode(dbName)&""""" style=""""width:70%;""""><br><INPUT TYPE=submit name=CreateDB Value=创建数据库></FORM></center>"")"&vbcrlf
			temp=temp&"End Sub" & vbCrlf& vbCrlf
			temp=temp& "Sub CreateMDB()" & vbCrlf
			temp=temp& "	dim cat,NewDB_Name" & vbCrlf
			temp=temp& "	NewDB_Name=request(""form_dbname"")" & vbCrlf
			temp=temp& "	if NewDB_Name<>"""" then" & vbCrlf
			temp=temp& "		if instr(NewDB_Name,"":\"")=0 and instr(NewDB_Name,"":/"")=0 then" & vbCrlf
			temp=temp& "			NewDB_Name=Server.MapPath(NewDB_Name)" & vbCrlf
			temp=temp& "		end if " & vbCrlf
			temp=temp& "		set cat=Server.CreateObject(""ADOX.Catalog"") " & vbCrlf
			temp=temp& "		cat.Create ""Provider=Microsoft.Jet.OLEDB.4.0;Data Source=""&NewDB_Name" & vbCrlf
			temp=temp& "		set cat=nothing " & vbCrlf
			temp=temp& "		CreateDB(NewDB_Name)" & vbCrlf
			temp=temp& "		response.write vbcrlf&""OK""" & vbCrlf
			temp=temp& "	else" & vbCrlf
			temp=temp& "		set cat=nothing " & vbCrlf
			temp=temp& "		call main()" & vbCrlf
			temp=temp& "	end if" & vbCrlf
			temp=temp& "End Sub"
			temp=tplHead&temp&vbcrlf&"%"&">"
		end if
		Dim ExtName:if enMode=0 then:ExtName=".Sql":else:ExtName=".Asp":end if
		call Ados_Write(temp,dbName&ExtName,"utf-8")
		rw "<br><img width=100 height=0>"&dbName&"的SQL脚本编写完成",1
		rw "<img width=100 height=0>已经保存文件为<b><font color=blue>"&dbName&ExtName&"</font></b>[<a href=?>返回</a>]:",1
		rw "<center><textarea style=""width:70%;height:500px;"" wrap=""off"">"&server.Htmlencode(temp)&"</textarea></center>",1
		Response.Write tpl_footer & "" & VBCrlf
	End Sub

	Function CreatTableSql(byval tableName,exec)
		dim cols
		dim TmpStr
		Set cols=Conn.openSchema(4)
		dim splitchar,splitchar1
		if exec=1 then
			splitchar=""""
			splitchar1="""&_"
		else
			splitchar=""
			splitchar1=""
		end if
		cols.filter="Table_name='"&tableName&"'"
		if cols.eof then
		   exit function
		end if
		dim cat,autoclumn,n,chkPrimaryKey : n=0
		' 编写表脚本
		autoclumn=GetAutoincrementCoulmnT(tableName)
		if exec=1 then
			TmpStr="Conn.execute(""CREATE TABLE ["&tableName&"] (""&_"& vbcrlf
		else
			TmpStr="CREATE TABLE ["&tableName&"] ("& vbcrlf
		end if
		dim autoclumnStr,columnStr
		if autoclumn<>"" then
			autoclumnStr= "	"&splitchar&"["& autoclumn &"] integer IDENTITY (1,"&GetIncrement(tableName,autoclumn)&") not null"
		end if
		do
			n=n+1
			cols.filter="Table_name='"&tableName&"' and ORDINAL_POSITION="&n
			if cols.eof  then exit do
			if n>1 then TmpStr=TmpStr&"," & splitchar1 & vbcrlf
			if autoclumn=cols("Column_name") then
				TmpStr=TmpStr & autoclumnStr
			else
				TmpStr=TmpStr & "	"&splitchar&"["& cols("Column_name") &"] "& lcase(datatypeStr(cols("DATA_TYPE"),cols("CHARACTER_MAXIMUM_LENGTH")))& defaultStr(cols("DATA_TYPE"),cols("COLUMN_DEFAULT"),exec) & nullStr(cols("IS_NULLABLE"))
			end if
			cols.movenext
		loop
			TmpStr=TmpStr & splitchar1 & vbcrlf &"	"&splitchar&")"
		cols.close
		if exec=1 then
			TmpStr=TmpStr&""")"
		end if
		'' 编写表脚本
		'	autoclumn=GetAutoincrementCoulmnT(tableName)
		'	if exec=1 then
		'		TmpStr="Conn.execute(""CREATE TABLE ["&tableName&"] (""&_"& vbcrlf
		'	else
		'		TmpStr="CREATE TABLE ["&tableName&"] ("& vbcrlf
		'	end if
		'	if autoclumn<>"" then
		'		TmpStr=TmpStr & "	"&splitchar&"["& autoclumn &"] integer IDENTITY (1,"&GetIncrement(tableName,autoclumn)&") not null"
		'		n=n+1
		'	end if
		'
		'	cols.filter="Table_name='"&tableName&"' and column_name<>'"&autoclumn&"'"
		'	while not cols.eof
		'		if n>0 then TmpStr=TmpStr&"," & splitchar1 & vbcrlf
		'		TmpStr=TmpStr & "	"&splitchar&"["& cols("Column_name") &"] "& lcase(datatypeStr(cols("DATA_TYPE"),cols("CHARACTER_MAXIMUM_LENGTH")))& defaultStr(cols("DATA_TYPE"),cols("COLUMN_DEFAULT"),exec) & nullStr(cols("IS_NULLABLE"))
		'		cols.movenext
		'		n=n+1
		'	wend
		'		TmpStr=TmpStr & splitchar1 & vbcrlf &"	"&splitchar&")"
		'	cols.close
		'	if exec=1 then
		'		TmpStr=TmpStr&""")"
		'	end if
		' 编写索引脚本
		dim InxArr,i,kstr,j,tmpStr1
		InxArr=getInxArr(tableName)
		Set cols=Conn.openSchema(12)
		for i=0 to ubound(InxArr)
			cols.filter="Table_name='"&tableName&"' and index_name='"&InxArr(i)&"'"
			kstr=""
			tmpStr1=""
			if Not isForeignIndex(tableName,InxArr(i)) then '外键索引不进行编写
				while not cols.eof
					kstr=kstr&",["&cols("column_name")&"] "&GetInxDesc(TableName,InxArr(i),cols("column_name"))
					cols.movenext
				wend
				tmpStr1=tmpStr1&"CREATE "
				if isUnique(TableName,InxArr(i)) then tmpStr1=tmpStr1&"Unique "
				tmpStr1=tmpStr1&"INDEX ["&InxArr(i)&"] on ["&tableName&"]("&mid(kstr,2)&")"
				if isPrimaryKey(TableName,InxArr(i)) then tmpStr1=tmpStr1&" with Primary"
				if exec=1 then tmpStr1="Conn.execute("""&tmpStr1&""")"
				tmpStr=tmpStr&vbcrlf&tmpStr1
			end if
		next
		cols.close
		cols.filter=0
		CreatTableSql=TmpStr
	End Function

	Sub CreateMDB()
		'改配置表名和列名
		dim cat,NewDB_Name
		NewDB_Name=request("form_dbname")
		if NewDB_Name<>"" then
			if instr(NewDB_Name,":\")=0 and instr(NewDB_Name,":/")=0 then
				NewDB_Name=Server.MapPath(NewDB_Name)
			end if
			set cat=Server.CreateObject("ADOX.Catalog")
			cat.Create "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="&NewDB_Name
			set cat=nothing
			CreateDB(NewDB_Name)
			response.write vbcrlf&"OK"
		else
			set cat=nothing
			call main()
		end if
	End Sub

	Function CreatViewSql(Byval exec)
		dim cols
		dim FKtable,PK_cols,FK_cols,tmpStr,tmpStr1,VIEW_DEFINITION
		Set cols=Conn.openSchema(23)
		cols.filter=0
		while not cols.eof
			tmpStr1=""
			VIEW_DEFINITION=replace(cols("VIEW_DEFINITION"),chr(13),"")
			VIEW_DEFINITION=replace(VIEW_DEFINITION,chr(10)," ")
			tmpStr1="Create view ["&cols("TABLE_NAME")&"] As "&VIEW_DEFINITION&""
			if exec=1 then tmpStr1="Conn.execute("""&tmpStr1&""")"
			tmpStr=tmpStr&vbcrlf&tmpStr1
			cols.movenext
		wend
		cols.close
		set cols=nothing
		CreatViewSql=tmpStr
	End Function

	Function CreatForeignSql(Byval exec)
		dim cols
		dim FKtable,PK_cols,FK_cols,tmpStr,tmpStr1
		Set cols=Conn.openSchema(27)
		cols.filter="PK_NAME<>Null"
		while not cols.eof
			tmpStr1=""
			tmpStr1="ALTER TABLE ["&cols("FK_TABLE_NAME")&"] "&_
					"Add CONSTRAINT ["&cols("FK_NAME")&"] "&_
					"FOREIGN KEY (["&cols("FK_COLUMN_NAME")&"]) REFERENCES "&_
					"["&cols("PK_TABLE_NAME")&"] (["&cols("PK_COLUMN_NAME")&"]) "
			if cols("UPDATE_RULE")="CASCADE" then	tmpStr1=tmpStr1&"ON UPDATE CASCADE "
			if cols("DELETE_RULE")="CASCADE" then	tmpStr1=tmpStr1&"ON DELETE CASCADE "
			if exec=1 then tmpStr1="Conn.execute("""&tmpStr1&""")"
			tmpStr=tmpStr&vbcrlf&tmpStr1
			cols.movenext
		wend
		cols.filter=0
		cols.close
		set cols=nothing
		CreatForeignSql=tmpStr
	End Function

	'判断是否是外键索引
	Function isForeignIndex(Byval TableName,Byval indexName)
		dim cols
		Set cols=Conn.openSchema(27)
		cols.filter="FK_TABLE_Name='"&TableName&"' and FK_NAME='"&indexName&"'"
		if Not cols.eof then
			isForeignIndex=true
		else
			isForeignIndex=false
		end if
	End Function
	'取得索引列的排序属性
	Function GetInxDesc(Byval TableName,Byval indexName,Byval ColumnName)
		dim cat
		set cat=Server.CreateObject("ADOX.Catalog")
		cat.ActiveCONNection =ConnStr
		if cat.Tables(""&TableName&"").Indexes(""&indexName&"").Columns(""&ColumnName&"").SortOrder=2 then
			GetInxDesc="Desc"
		else
			GetInxDesc=""
		end if
		set cat=nothing
	End Function
	'取得列数组
	Function getColumArr(Byval tableName)
		dim cols,arr(),n
		redim arr(-1)
		n=0
		redim arr(n)
		set cols=Conn.openSchema(4)
		cols.filter="Table_Name='"&tableName&"'"
		while not cols.eof
			redim Preserve arr(n)
			arr(n)=cols("column_name")
			cols.movenext
			n=n+1
		wend
		cols.filter=0
		cols.close
		set cols=nothing
		getColumArr=arr
	End Function
	'取得索引数组
	Function getInxArr(Byval tableName)
		dim cols,arr(),n,tmpCol
		redim arr(-1)
		n=0
		set cols=Conn.openSchema(12)
		cols.filter="Table_Name='"&tableName&"'"
		while not cols.eof
			if cols("index_name")<>tmpCol then
				redim Preserve arr(n)
				arr(n)=cols("index_name")
				n=n+1
			end if
			tmpCol=cols("index_name")
			cols.movenext
		wend
		cols.filter=0
		cols.close
		set cols=nothing
		getInxArr=arr
	End Function

	Function isUnique(Byval TableName,Byval IndexName)
		dim cols
		set cols=Conn.openSchema(12)
		cols.filter="Table_Name='"&TableName&"' and Index_Name='"&IndexName&"' and UNIQUE=True"
		if not cols.eof then
			isUnique=true
		else
			isUnique=false
		end if
		cols.filter=0
		cols.close
		set cols=nothing
	End Function

	Function isPrimaryKey(Byval TableName,Byval IndexName)
		dim cols
		set cols=Conn.openSchema(12)
		cols.filter="Table_Name='"&TableName&"' and Index_Name='"&IndexName&"' and PRIMARY_KEY=True"
		if not cols.eof then
			isPrimaryKey=true
		else
			isPrimaryKey=false
		end if
		cols.filter=0
		cols.close
		set cols=nothing
	End Function

	Function getPrimaryKey(Byval tableName,Byval columnName)
		dim cols
		Set cols=Conn.openSchema(12)
		cols.filter="Table_Name='"&tableName&"' and Column_Name='"&columnName&"' and PRIMARY_KEY=True"
		if not cols.eof then
			getPrimaryKey=cols("INDEX_NAME")
			'isPrimaryKey=true
		else
			getPrimaryKey=""
			'isPrimaryKey=false
		end if
		cols.filter=0
		cols.close
		set cols=nothing
	End Function

	Function GetIncrement(Byval tableName,Byval columnName)
		dim cat
		set cat=Server.CreateObject("ADOX.Catalog")
		cat.ActiveCONNection =ConnStr
		GetIncrement=cat.Tables(""&TableName&"").Columns(""&columnName&"").Properties("Increment")
		set cat=nothing
	End Function

	Function GetSeed(Byval tableName,Byval columnName)
		dim cat
		set cat=Server.CreateObject("ADOX.Catalog")
		cat.ActiveCONNection =ConnStr
		GetSeed=cat.Tables(""&TableName&"").Columns(""&columnName&"").Properties("Seed")
		set cat=nothing
	End Function

	'通用,内部属性取得自动编号，对SQLserver Access都可以
	Function GetAutoincrementCoulmnT(Byval tablename)
		dim i, rs
		Set rs=Server.CreateObject("adodb.recordSet")
		rs.open "select * from [" & tablename & "] where 1=0",Conn,0,1
		for i=0 to rs.fields.count-1
			if rs(i).Properties("isAutoIncrement")=True then
				GetAutoincrementCoulmnT=rs(i).name
				rs.close
				exit function
			end if
		next
		rs.close
	End Function

	Function datatypeStr(Byval DATA_TYPE, Byval CHARACTER_MAXIMUM_LENGTH)
		select case DATA_TYPE
		case 130
			if CHARACTER_MAXIMUM_LENGTH=0 then
				datatypeStr="Text"	'LongText
			else datatypeStr="varchar("&CHARACTER_MAXIMUM_LENGTH&")"  'char() 、varchar()
			end if
		case 17  datatypeStr="tinyint"
		case 2   datatypeStr="Smallint"
		case 3   datatypeStr="integer"
		case 4   datatypeStr="real" 'or  /同意词 float4
		case 5 	 datatypeStr="float" 'or  /同意词 float8
		case 6	 datatypeStr="money" 'or  /同意词  CURRENCY
		case 7	 datatypeStr="datetime"
		case 11  datatypeStr="bit"
		case 72  datatypeStr="UNIQUEIDENTIFIER"  'or  /同意词  GUID
		case 131 datatypeStr="DECIMAL"  'or  /同意词  DEC
		case 128 datatypeStr="BINARY"  'or  /同意词  DEC
		end select 'AUTOINCREMENT
	End Function

	Function defaultStr(Byval DATA_TYPE, Byval COLUMN_DEFAULT, Byval exec)
		if isNull(COLUMN_DEFAULT) then
			defaultStr=""
			exit function
		end if
		dim splitchar
		if exec=1 then
			splitchar=""""""
		else
			splitchar=""""
		end if
		select case DATA_TYPE
		case 130
			if left(COLUMN_DEFAULT,1)="""" and right(COLUMN_DEFAULT,1)="""" then
				COLUMN_DEFAULT=mid(COLUMN_DEFAULT,2,len(COLUMN_DEFAULT)-2)
			end if
				COLUMN_DEFAULT=replace(COLUMN_DEFAULT,"""",splitchar)
			 defaultStr=" Default "&splitchar & COLUMN_DEFAULT & splitchar
		case 128
			 defaultStr=" Default 0x"&COLUMN_DEFAULT&""  'or  /同意词  DEC
		case else
			 defaultStr=" Default "&COLUMN_DEFAULT&""
		end select
	End Function

	Function nullStr(Byval IS_NULLABLE)
		if IS_NULLABLE then
			nullStr=""
		else
			nullStr=" not null "
		end if
	End Function

	'断点调试 num=0 中断
	Sub rw(str,num)
		Dim istr:istr=str
		Dim inum:inum=num
		response.write str & "<br>"
		if inum=0 then response.end
	End Sub

	Function strSafe(Byval s)
		Dim str : str = s
		Str=replace(Str,"'","")
		Str=Replace(Str,Chr(0),"")
		Str=Replace(Str," ","")
		strSafe=Str
	End Function

	Function Ados_Read(Byval filename,Byval charset)
		dim osteam, temp, filepath : filepath = filename
		if instr(filename,":\")=0 and instr(filename,":/")=0 then
			filepath=Server.mappath(filename)
		end if
		set osteam=Server.CreateObject(AB.SteamName)
		osteam.mode=3
		osteam.type=2 'text
		osteam.charset=charset
		osteam.open
		osteam.loadFromFile filepath
		temp = osteam.ReadText()
		osteam.close
		set osteam=nothing
		Ados_Read = temp
	End Function

	Sub Ados_Write(Byval str,Byval filename, Byval charset)
		dim osteam, filepath : filepath = filename
		if instr(filename,":\")=0 and instr(filename,":/")=0 then
			filepath=Server.mappath(filename)
		end if
		set osteam=Server.CreateObject(AB.SteamName)
		osteam.mode=3
		osteam.type=2 'text
		osteam.charset=charset
		osteam.open
		osteam.setEos
		osteam.WriteText(str)
		osteam.SaveToFile filepath,2
		osteam.close
		set osteam=nothing
	End Sub

	Sub openDB(Byval db)
		if inStr(db,":/")=0 and inStr(db,":\")=0 then
			db=server.mappath(db)
		end if
		Set Conn = Server.CreateObject("ADODB.Connection")
		On Error Resume Next
		Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & db
		if err.number<>0 then
			rw "数据库打开失败,错误为:" & err.description,0
			err.clear
		end if
		On Error Goto 0
	End Sub

End Class
%>